{Name: Lu Wang                                                              }
{Date: June 10, 1996                                                        }
{Purpose: The purpose of this program is let the user play the game mine-   }
{         sweeper.                                                          }
{Files...                                                                   }
{COPYRIT3.TXT................contains copyright information                 }
{HELP.TXT....................help file                                      }
{WINNER.TXT..................list the top five winners                      }
{WINNER.TXT used by program9.pas                                            }
{Name                          Score                                        }

PROGRAM Program9;

USES CRT, GRAPH;

CONST

     Wait = 50;                       {Delay constants}
     Wait1 = 5;
     Wait2 = 1500;
     Wait3 = 100;

     Board_Size = 12;

     Choice : ARRAY [1..6] OF STRING   {menu choices}
                   = ('Start', 'Help', 'Hall of Fame',
                      'Option', 'Copyright', 'Exit');
     Menu_Size = 6;

TYPE
     Letter = STRING [1];
     Status_Type = (COVERED, REVEALED, MARKED, QUES);
     Board_Type = RECORD
                       Field : ARRAY [1..Board_Size, 1..Board_Size] OF Letter;
                       Status : ARRAY [1..Board_Size, 1..Board_Size] OF Status_Type;
                  END;

     Player_Type = RECORD
                        Name : STRING [31];
                        Score : INTEGER;
                   END;

{============================Functions======================================}
FUNCTION Add (Cell : Letter) : Letter;

VAR
     Temp, Err : INTEGER;

BEGIN

     {determine how many mines a cell touches}
     IF Cell <> '+'
          THEN
               BEGIN
                    VAL (Cell, Temp, Err);
                    Temp := Temp + 1;
                    STR (Temp, Cell);

               END; {if}
     Add := Cell;

END; {end of function}

FUNCTION Restrict_Input (x_Start, y, S_Length : INTEGER) : STRING;

VAR
     Count,
     x : INTEGER;
     S : STRING;
     Ch : CHAR;

BEGIN

     x := x_Start;
     S := '';
     Ch := ' ';

     REPEAT
           SETCOLOR (WHITE);
           OUTTEXTXY (x + 8 * LENGTH (S), y, '_');
           Ch := READKEY;

           IF LENGTH (S) = S_Length
                THEN
                     WHILE (Ch <> CHR (8)) AND (Ch <> CHR (13)) DO
                          Ch := READKEY;

           IF Ch <> CHR (13)
                THEN
                     CASE Ch OF
                          CHR (8) : BEGIN        {Back space key}

                                         {Erase the last character from the screen}
                                         SETCOLOR (BLACK);
                                         OUTTEXTXY (x, y, S);
                                         OUTTEXTXY (x + 8 * LENGTH (S), y, '_');
                                         DELETE (S, LENGTH (S), 1);
                                         SETCOLOR (WHITE);
                                         OUTTEXTXY (x, y, S);

                                    END;

                          ELSE BEGIN

                                    {Write the character to screen}
                                    SETCOLOR (BLACK);
                                    OUTTEXTXY (x, y, S);
                                    OUTTEXTXY (x + 8 * LENGTH (S), y, '_');
                                    S := S + Ch;
                                    SETCOLOR (WHITE);
                                    OUTTEXTXY (x, y, S);
                                    OUTTEXTXY (x + 8 * LENGTH (S), y, '_');
                               END;

                     END; {case}

     UNTIL Ch = CHR (13);
     SETCOLOR (BLACK);
     OUTTEXTXY (x + 8 * LENGTH (S), y, '_');

     FOR Count := LENGTH (S) + 1 TO S_Length DO
          S := S + ' ';

     Restrict_Input := S;

END; {end of function}

FUNCTION Scoring (Size, Cells, Right, Wrong : INTEGER) : INTEGER;

VAR
     Temp : INTEGER;

BEGIN

     {Calculate the score}
     Temp := SQR (Size) - Cells;
     Scoring := Temp + Right * 5 - Wrong * 10;

END; {end of function}

{============================Procedures=====================================}
PROCEDURE SetUp;

VAR
     gd,                               {Graphics Driver}
     gm,                               {Graphics Mode}
     err : INTEGER;                    {Error Code}

BEGIN
     gd := DETECT;
     INITGRAPH (gd, gd, ' ');

     err := GraphResult;
     IF err <> grOK
          THEN BEGIN
                    WRITELN ('Graphics error = ', GraphErrorMsg (err));
                    READLN;
                    HALT;
               END; {If}

     SETGRAPHMODE (VGAHI);

END; {end of procedure}

PROCEDURE Beep;

BEGIN

     {Emits a beep}
     SOUND (850);
     DELAY (Wait);
     NOSOUND;

END; {end of procedure}

PROCEDURE Draw_Underline (Center_X : INTEGER);

CONST
     Wait = 50;                        {delay constant}

VAR
     x : INTEGER;                      {loop variable}

BEGIN

     x := 0;

     WHILE x < 140 DO
          BEGIN
               SETFILLSTYLE (SOLIDFILL, RED);
               SETPALETTE (RED, 100);
               BAR (Center_X - x, 230, Center_X + x, 240);

               SETFILLSTYLE (SOLIDFILL, BLUE);
               BAR (Center_X - x, 280, Center_X + x, 290);
               DELAY (Wait);

               x := x + 3;
          END; {for}

END; {end of procedure}

PROCEDURE Star_Field (MaxX, MaxY, MinX, MinY : INTEGER);

VAR
     Count, Count1 : INTEGER;          {loop variables}

     x, y : ARRAY [1..400] OF INTEGER; {x, y coordinates of the stars}

BEGIN

     Count := 1;

     FOR Count := 1 TO 400 DO
          BEGIN
               x [Count] := RANDOM (MaxX) + MinX;
               y [Count] := RANDOM (MaxY) + MinY;
          END; {for}

     Count := 1;

     WHILE Count <= 400 DO
          BEGIN

               PUTPIXEL (x [Count], y [Count], WHITE);
               PUTPIXEL (x [Count + 1], y [Count + 1], LIGHTGRAY);
               PUTPIXEL (x [Count + 2], y [Count + 2], DARKGRAY);
               PUTPIXEL (x [Count + 3], y [Count + 3], LIGHTRED);
               PUTPIXEL (x [Count + 4], y [Count + 4], YELLOW);
               Count := Count + 5;
          END; {while}

END; {end of procedure}

PROCEDURE Header;

CONST

     Start_Y1 = 200;                   {y coordinate of the header}
     Start_Y2 = 250;

VAR
     Center_X,                         {center of the screen}
     x1, x2,                           {x coordinate of the text}
     y : INTEGER;                      {y coordinate of the credits}

     Credit, Name : STRING;            {text from the CREDITS.TXT}

     File1 : TEXT;                     {file handle}

BEGIN

     SETBKCOLOR (BLACK);

     Center_X := GETMAXX DIV 2;
     x1 := 1;
     x2 := 614;
     SETTEXTSTYLE (SMALLFONT, HORIZDIR, 8);
     SETFILLSTYLE (SOLIDFILL, BLACK);
     Star_Field (640, 480, 1, 1);

     {Move text across the screen}
     WHILE x1 < 182 DO
          BEGIN

               SETCOLOR (LIGHTGREEN);
               OUTTEXTXY (x1, Start_Y1, 'Computer Science 12');
               OUTTEXTXY (x2, Start_Y2, 'Program #9');

               SETCOLOR (BLACK);
               OUTTEXTXY (x1, Start_Y1, 'Computer Science 12');
               OUTTEXTXY (x2, Start_Y2, 'Program #9');

               x1 := x1 + 2;
               x2 := x2 - 4;

               DELAY (Wait);

          END; {while}

          SETCOLOR (WHITE);
          OUTTEXTXY (x1, Start_Y1, 'Computer Science 12');
          OUTTEXTXY (x2, Start_Y2, 'Program #9');

          Draw_Underline (Center_X);

          DELAY (Wait2);
          SETCOLOR (LIGHTGRAY);
          OUTTEXTXY (x1, Start_Y1, 'Computer Science 12');
          OUTTEXTXY (x2, Start_Y2, 'Program #9');

          {GRADUAL FADE OF THE LINE}
          DELAY (Wait2);
          SETCOLOR (DARKGRAY);
          OUTTEXTXY (x1, Start_Y1, 'Computer Science 12');
          OUTTEXTXY (x2, Start_Y2, 'Program #9');
          SETPALETTE (RED, RED);
          SETPALETTE (LIGHTBLUE, BLUE);

          DELAY (Wait2);
          SETCOLOR (BLACK);
          SETFILLSTYLE (SOLIDFILL, BLACK);
          OUTTEXTXY (x1, Start_Y1, 'Computer Science 12');
          FLOODFILL (Center_X, 235, BLACK);
          OUTTEXTXY (x2, Start_Y2, 'Program #9');
          FLOODFILL (Center_X, 285, BLACK);

END; {end of procedure}

PROCEDURE Write_Text;

VAR
     x, y,
     c, d : INTEGER;                      {loop variable}
     Ch : CHAR;

BEGIN

     SETCOLOR (CYAN);
     SETTEXTJUSTIFY (CENTERTEXT, CENTERTEXT);
     SETFILLSTYLE (EMPTYFILL, BLACK);

     x := GETMAXX DIV 2;
     y := GETMAXY DIV 2;

     FOR d := 1 TO 10 DO
          BEGIN
               FLOODFILL (0, 0, GREEN);
               SETTEXTSTYLE (GOTHICFONT, HORIZDIR, d);
               Star_Field (GETMAXX, GETMAXY, 0, 0);
               FOR c := 1 TO 6 DO
                    OUTTEXTXY (x + c, y + c, 'Minesweeper');
               DELAY (Wait3);

          END; {for}

     SETTEXTSTYLE (DEFAULTFONT, HORIZDIR, 1);
     OUTTEXTXY (x, 400, 'Press any to continue');
     REPEAT
          SETPALETTE (CYAN, RANDOM (15) + 1);
          DELAY (Wait3);
     UNTIL KEYPRESSED;
     Ch := READKEY;

END; {end of procedure}

PROCEDURE View_Screen;

{This procedure draws the view screen}

BEGIN

     SETFILLSTYLE (SOLIDFILL, BLACK);
     FLOODFILL (1, 1, BROWN);
     SETCOLOR (LIGHTBLUE);

     ARC (580, 50, 350, 100, 50);      {Arc1-A}
     ARC (50, 40, 90, 180, 40);        {Arc2-A}
     LINE (580, 0, 50, 0);             {Line, Arc1-A to Arc2-A}

     ARC (50, 430, 180, 270, 30);      {Arc3-A}
     LINE (10, 40, 20, 430);           {Line, Arc2-A to Arc3-A}

     ARC (580, 410, 270, 0, 50);       {Arc4-A}
     LINE (50, 460, 580, 460);         {Line, Arc3-A to Acr4-A}
     LINE (630, 410, 630, 50);         {Line, Arc4-A to Acr1-A}

     ARC (520, 70, 350, 100, 50);      {Arc1-B}
     ARC (520, 390, 270, 0, 50);       {Arc4-B}
     LINE (570, 390, 570, 70);         {Line, Arc1-B to Arc4-B}

     ARC (50, 40, 90, 180, 20);        {Arc2-B}
     LINE (520, 20, 50, 20);           {Line, Arc1-B to Arc2-B}

     ARC (50, 430, 180, 270, 10);      {Arc3-B}
     LINE (30, 40, 40, 430);           {Line, Arc3-B to Arc2-B}
     LINE (50, 440, 520, 440);         {Line, Arc3-B to Arc4-B}

     SETFILLSTYLE (SOLIDFILL, LIGHTBLUE);
     FLOODFILL (28, 40, LIGHTBLUE);

     BAR (32, 100, 570, 120);
     BAR (160, 120, 180, 440);

     SETTEXTJUSTIFY (LEFTTEXT, TOPTEXT);
     SETTEXTSTYLE (DEFAULTFONT, HORIZDIR, 1);
     SETCOLOR (WHITE);
     OUTTEXTXY (50, 36, 'Minefield');

END; {end of procedure}

PROCEDURE Initialize (VAR Mine_Field : Board_Type; Mines, Size : INTEGER);

VAR
     a, b, c : INTEGER;
     b_Small, b_Big, c_Small, c_Big : BOOLEAN;

BEGIN
     FOR a := 1 TO Size DO
          FOR b := 1 TO Size DO
               BEGIN
                    Mine_Field.Field [a, b] := '0';
                    Mine_Field.Status [a, b] := COVERED;
               END;

     a := 0;
     WHILE a < Mines DO
        WITH Mine_Field DO
           BEGIN
              b := RANDOM (Size) + 1;
              c := RANDOM (Size) + 1;
              IF Field [b, c] <> '+'
                THEN BEGIN
                  Field [b, c] := '+';
                  a := a + 1;

                  IF b - 1 > 0
                     THEN
                        BEGIN
                           Field [b - 1, c] := Add (Field [b - 1, c]);
                           IF c - 1 > 0
                              THEN
                                 Field [b - 1, c - 1] := Add (Field [b - 1, c - 1]);
                           IF c + 1 <= Size
                              THEN
                                 Field [b - 1, c + 1] := Add (Field [b - 1, c + 1]);
                        END; {if}

                  IF b + 1 <= Size
                     THEN
                        BEGIN
                           Field [b + 1, c] := Add (Field [b + 1, c]);
                           IF c - 1 > 0
                              THEN
                                 Field [b + 1, c - 1] := Add (Field [b + 1, c - 1]);
                           IF c + 1 <= Size
                              THEN
                                 Field [b + 1, c + 1] := Add (Field [b + 1, c + 1]);
                        END; {if}

                  IF c - 1 > 0
                     THEN
                        Field [b, c - 1] := Add (Field [b, c - 1]);

                  IF c + 1 <= Size
                     THEN
                        Field [b, c + 1] := Add (Field [b, c + 1]);

                END; {if}

           END; {with}

END; {end of procedure}

PROCEDURE Board (Size : INTEGER; VAR p, q : POINTER);

VAR
     w, x, y,
     Pic_Size : INTEGER;

BEGIN

     {draws the minefield on the screen}
     w := 280 DIV Size;
     SETACTIVEPAGE (1);

     {Draw a covered cell}
     SETCOLOR (WHITE);
     RECTANGLE (1, 1, w, w);
     SETFILLSTYLE (SOLIDFILL, WHITE);
     FLOODFILL (2, 2, WHITE);

     SETCOLOR (LIGHTGRAY);
     RECTANGLE (1 + w DIV 10, 1 + w DIV 10, w - w DIV 10, w - w DIV 10);
     SETFILLSTYLE (SOLIDFILL, LIGHTGRAY);
     FLOODFILL (w DIV 2, w DIV 2, LIGHTGRAY);

     SETCOLOR (DARKGRAY);
     MOVETO (1, w);
     LINETO (1 + w DIV 10,  w - w DIV 10);
     LINETO (w - w DIV 10, w - w DIV 10);
     LINETO (w - w DIV 10, w DIV 10);
     LINETO (w, 1);
     LINETO (w, w);
     LINETO (1, w);
     SETFILLSTYLE (SOLIDFILL, DARKGRAY);
     FLOODFILL (w - 1, w - 1, DARKGRAY);

     Pic_Size := IMAGESIZE (1, 1, w, w);
     GETMEM (p, Pic_Size);
     GETIMAGE (1, 1, w, w, p^);

     {Draw a uncovered cell}
     SETCOLOR (WHITE);
     SETFILLSTYLE (SOLIDFILL, WHITE);
     RECTANGLE (100, 100, 99 + w, 99 + w);
     FLOODFILL (105, 105, WHITE);

     SETCOLOR (BLACK);
     RECTANGLE (100 + w DIV 10, 100 + w DIV 10, 99 + w - w DIV 10 , 99 + w - w DIV 10);
     SETFILLSTYLE (SOLIDFILL, BLACK);
     FLOODFILL (100 + w DIV 2, 100 + w DIV 2, BLACK);

     SETCOLOR (LIGHTGRAY);
     RECTANGLE (100 + w DIV 5, 100 + w DIV 5, 99 + w - w DIV 10, 99 + w - w DIV 10);
     SETFILLSTYLE (SOLIDFILL, LIGHTGRAY);
     FLOODFILL (100 + w DIV 2, 100 + w DIV 2, LIGHTGRAY);

     Pic_Size := IMAGESIZE (100, 100, 99 + w, 99 + w);
     GETMEM (q, Pic_Size);
     GETIMAGE (100, 100, 99 + w, 99 + w, q^);

     SETACTIVEPAGE (0);

     SETVIEWPORT (230, 140, 540, 420, TRUE);

     FOR x := 0 TO Size - 1 DO
          FOR y := 0 TO Size - 1 DO
               PUTIMAGE (x * w, y * w, p^, NORMALPUT);

     SETVIEWPORT (0, 0, GETMAXX, GETMAXY, TRUE);

END; {end of procedure}

PROCEDURE Get_Name (VAR Player : Player_Type);

VAR
     First, Last : STRING [15];

BEGIN
     SETTEXTSTYLE (DEFAULTFONT, HORIZDIR, 1);

     SETCOLOR (LIGHTGREEN);
     OUTTEXTXY (50, 46, 'Last name: ');
     Beep;
     Last := Restrict_Input (138, 46, 15);
     SETCOLOR (GREEN);
     OUTTEXTXY (50, 46, 'Last name: ');

     SETCOLOR (LIGHTGREEN);
     OUTTEXTXY (50, 56, 'First name: ');
     Beep;
     First := Restrict_Input (146, 56, 15);
     SETCOLOR (GREEN);
     OUTTEXTXY (50, 56, 'First name: ');

     Player.Name := Last + ' ' + First;

END; {end of procedure}

PROCEDURE Uncover (x, y, Len, Size : INTEGER;
                   Num : Letter;
                   VAR q : POINTER;
                   VAR Status : Status_Type;
                   VAR Cells : INTEGER);

VAR
     z : INTEGER;

BEGIN

     {Uncover a cell}
     x := (x - 1) * Len;
     y := (y - 1) * Len;
     z := Len DIV 10;

     IF Status <> REVEALED
        THEN
           BEGIN
              PUTIMAGE (x, y, q^, NORMALPUT);
              Cells := Cells - 1;
              x := x + Len DIV 2;
              y := y + Len DIV 2;
              IF Num = '0'
                   THEN SETCOLOR (LIGHTCYAN)
                   ELSE IF Num = '1'
                             THEN SETCOLOR (GREEN)
                             ELSE IF Num = '2'
                                       THEN SETCOLOR (BLUE)
                                       ELSE SETCOLOR (RED);

              CASE Size OF
                   8 : SETTEXTSTYLE (SMALLFONT, HORIZDIR, 8);
                   10 : SETTEXTSTYLE (SMALLFONT, HORIZDIR, 6);
                   12 : SETTEXTSTYLE (SMALLFONT, HORIZDIR, 4);
              END; {case}

              IF Num <> '+'
                 THEN
                    OUTTEXTXY (x, y, Num)
                 ELSE
                    BEGIN

                      {draw a mine}
                      SETCOLOR (BLACK);
                      CIRCLE (x, y, Len DIV 4);
                      SETFILLSTYLE (SOLIDFILL, BLACK);
                      FLOODFILL (x, y, BLACK);

                      x := x - Len DIV 2;
                      y := y - Len DIV 2;
                      IF Status = MARKED
                        THEN
                          BEGIN

                            {draw a red X through the mine}
                            SETCOLOR (RED);
                            SETLINESTYLE (SOLIDLN, 0, THICKWIDTH);
                            LINE (x + z, y + z, x + Len - z, y + Len - z);
                            SETLINESTYLE (SOLIDLN, 0, THICKWIDTH);
                            LINE (x + Len - z, y + z, x + z, y + Len - z);
                          END

                        ELSE
                          BEGIN
                            {draw rest of the mine}
                            SETCOLOR (BLACK);
                            LINE (x + z, y + z, x + Len - z, y + Len - z);
                            LINE (x + Len DIV 2, y + z, x + Len DIV 2, y + Len - z);
                            LINE (x + Len - z, y + z, x + z, y + Len - z);
                            LINE (x + z, y + Len DIV 2, x + Len - z, y + Len DIV 2);

                            x := x + Len DIV 2;
                            y := y + Len DIV 2;
                            SETCOLOR (WHITE);
                            RECTANGLE (x - z, y - z, x + z, y + z);
                            SETFILLSTYLE(SOLIDFILL, WHITE);
                            FLOODFILL (x, y, WHITE);

                          END;
                    END; {if-else}

           END; {if}

END; {end of procedure}

PROCEDURE Show_Cell (x, y, Len, Size : INTEGER;
                     VAR q : POINTER;
                     VAR Cells : INTEGER;
                     VAR Mine_Field : Board_Type);

BEGIN
  WITH Mine_Field DO
    BEGIN

      {Uncover the cell}
      Uncover (x, y, Len, Size, Field [x, y], q, Status [x, y], Cells);

      {Show surrounding cells}
      IF Field [x, y]  = '0'
       THEN BEGIN
        IF x - 1 > 0
         THEN BEGIN
          Uncover (x - 1, y, Len, Size, Field [x - 1, y], q, Status [x - 1, y], Cells);
          Status [x - 1, y] := REVEALED;
 {                   Show_Cell (x - 1, y, Len, q, Cells, Mine_Field);}

          IF y - 1 > 0
           THEN BEGIN
            Uncover (x - 1, y - 1, Len, Size, Field [x - 1, y - 1], q, Status [x - 1, y - 1], Cells);
            Status [x - 1, y - 1] := REVEALED;
{                       Show_Cell (x - 1, y - 1, Len, q, Cells, Mine_Field);}

            END;

          IF y + 1 <= Size
           THEN BEGIN
            Uncover (x - 1, y + 1, Len, Size, Field [x - 1, y + 1], q, Status [x - 1, y + 1], Cells);
            Status [x - 1, y + 1] := REVEALED;
{                       Show_Cell (x - 1, y + 1, Len, q, Cells, Mine_Field);}
            END;

       END; {if x - 1 > 0}

      IF x + 1 <= Size
       THEN BEGIN
        Uncover (x + 1, y, Len, Size, Field [x + 1, y], q, Status [x + 1, y], Cells);
        Status [x + 1, y] := REVEALED;
{                   Show_Cell (x + 1, y, Len, q, Cells, Mine_Field);}

        IF y - 1 > 0
         THEN BEGIN
          Uncover (x + 1, y - 1, Len, Size, Field [x + 1, y - 1], q, Status [x + 1, y - 1], Cells);
          Status [x + 1, y - 1] := REVEALED;
{                        Show_Cell (x + 1, y - 1, Len, q, Cells, Mine_Field);}
         END;

        IF y + 1 <= Size
          THEN BEGIN
           Uncover (x + 1, y + 1, Len, Size, Field [x + 1, y + 1], q, Status [x + 1, y + 1], Cells);
           Status [x + 1, y + 1] := REVEALED;
{                        Show_Cell (x + 1, y + 1, Len, q, Cells, Mine_Field);}
          END;

       END; {if x + 1 < Size}

      IF y - 1 > 0
       THEN BEGIN
        Uncover (x, y - 1, Len, Size, Field [x, y - 1], q, Status [x, y - 1], Cells);
        Status [x, y - 1] := REVEALED;
{                      Show_Cell (x, y - 1, Len, q, Cells, Mine_Field);}
       END;

      IF y + 1 <= Size
       THEN BEGIN
        Uncover (x, y + 1, Len, Size, Field [x, y + 1], q, Status [x, y + 1], Cells);
        Status [x, y + 1] := REVEALED;
{                      Show_Cell (x, y + 1, Len, q, Cells, Mine_Field);}
        END;

    END; {if Field [x, y] = '0'}

  END; {with}

END; {end of procedure}

PROCEDURE Happy_Face (Dead : BOOLEAN);

BEGIN

     {Draws a happy face}
     SETCOLOR (YELLOW);
     CIRCLE (320, 62, 30);
     SETFILLSTYLE(SOLIDFILL, YELLOW);
     FLOODFILL (320, 62, YELLOW);

     {eyes and eyes brows}
     SETCOLOR (BLACK);
     SETLINESTYLE (SOLIDLN, 0, THICKWIDTH);
     ARC (310, 50, 0, 180, 6);
     SETLINESTYLE (SOLIDLN, 0, THICKWIDTH);
     ARC (330, 50, 0, 180, 6);
     ELLIPSE (310, 58, 0, 360, 5, 7);
     ELLIPSE (330, 58, 0, 360, 5, 7);
     SETFILLSTYLE (SOLIDFILL, BLACK);
     FLOODFILL (310, 58, BLACK);
     FLOODFILL (330, 58, BLACK);

     {the mouth}
     IF Dead
          THEN
               BEGIN
                    SETCOLOR (YELLOW);
                    ARC (320, 70, 180, 0, 20);
                    SETCOLOR (LIGHTRED);
                    ARC (320, 84, 0, 180, 16);
               END

          ELSE
               BEGIN
                    SETCOLOR (LIGHTRED);
                    ARC (320, 70, 180, 0, 20);
               END;

END; {end of procedure}

PROCEDURE Top_Scores (Player : Player_Type);

CONST
     Max_Players = 6;

VAR
     c, d, x, Highest : INTEGER;
     File1 : TEXT;
     Ch : CHAR;
     Score_Sum : STRING;
     Name_Temp : STRING [31];
     Temp : Player_Type;
     Best : ARRAY [1..Max_Players] OF Player_Type;

BEGIN

     {Check to see if the score is in top 5}
     ASSIGN (File1, 'WINNER.TXT');
     RESET (File1);
     READLN (File1);
     READLN (File1);

     c := 1;

     {Remove extra spaces in the name}
     Best [c].Name := '';
     x := POS (' ', Player.Name);
     Best [c].Name := COPY (Player.Name, 1, x);
     DELETE (Player.Name, 1, 16);
     x := POS (' ', Player.Name) - 1;
     Best [c].Name := Best [c].Name + COPY (Player.Name, 1, x);
     Best [c].Score := Player.Score;
     Player.Name := Best [c].Name;

     WHILE NOT EOF (File1) DO
          BEGIN
               c := c + 1;
               READ (File1, Name_Temp);

               {Remove extra spaces}
               Best [c].Name := '';
               x := POS (' ', Name_Temp);
               Best [c].Name := COPY (Name_Temp, 1, x);
               DELETE (Name_Temp, 1, x);
               x := POS (' ', Name_Temp) - 1;
               Best [c].Name := Best [c].Name + COPY (Name_Temp, 1, x);

               READ (File1, Best [c].Score);
               READLN (File1);
          END;

     {using bubble sort to sort the scores}
     FOR c := 1 TO Max_Players - 1 DO
          FOR d := 1 TO Max_Players - 1 DO
               IF Best [d].Score < Best [d + 1].Score
                    THEN
                         BEGIN
                              Temp := Best [d];
                              Best [d] := Best [d + 1];
                              Best [d + 1] := Temp;
                         END;

     {show the scores}
     SETFILLSTYLE (SOLIDFILL, BLACK);
     FLOODFILL (300, 200, LIGHTBLUE);
     Star_Field (360, 280, 190, 140);

     SETCOLOR (GREEN);
     OUTTEXTXY (260, 150, 'Name');
     OUTTEXTXY (400, 150, 'Score');
     FOR c := 1 TO Max_Players DO
          BEGIN
               IF Best [c].Name = Player.Name
                    THEN SETCOLOR (LIGHTGREEN)
                    ELSE SETCOLOR (GREEN);
               STR (Best [c].Score, Score_Sum);
               OUTTEXTXY (260, 160 + c * 10, Best [c].Name);
               OUTTEXTXY (400, 160 + c * 10, Score_Sum);
          END;

     Ch := ' ';
     REPEAT
          Ch := READKEY;
     UNTIL Ch = CHR (13);

END; {end of procedure}

PROCEDURE Game (Mines, Size : INTEGER;
                VAR Games : INTEGER);

VAR
     Cells, Markers,
     x, y,
     x_Loc, y_Loc, Len,
     Right, Wrong,
     Temp : INTEGER;
     Dead : BOOLEAN;
     ch : CHAR;
     Game_Num, Score_Num : STRING;
     p, q : POINTER;
     Mine_Field : Board_Type;
     Player : Player_Type;

BEGIN

     Games := Games + 1;
     STR (Games, Game_Num);

     SETFILLSTYLE (SOLIDFILL, BLACK);
     FLOODFILL (377, 280, LIGHTBLUE);
     Markers := Mines;
     Initialize (Mine_Field, Mines, Size);
     Cells := SQR (Size);

     Get_Name (Player);
     Board (Size, p, q);
     Happy_Face (FALSE);

     {Write out the commands and game info}
     SETFILLSTYLE (SOLIDFILL, BLACK);
     FLOODFILL (100, 300, LIGHTBLUE);
     SETTEXTSTYLE (SMALLFONT, HORIZDIR, 5);

     SETCOLOR (LIGHTMAGENTA);
     SETTEXTJUSTIFY (LEFTTEXT, TOPTEXT);
     OUTTEXTXY (44, 130, 'Game #: ');
     OUTTEXTXY (44, 145, 'Score: ');
     OUTTEXTXY (100, 130, Game_Num);

     SETCOLOR (WHITE);
     OUTTEXTXY (44, 200, 'Commands: ');
     OUTTEXTXY (44, 215, 'C--mark a');
     OUTTEXTXY (44, 225, 'cell as a mine');
     OUTTEXTXY (44, 240, 'Q--mark a');
     OUTTEXTXY (44, 250, 'cell with a ?');
     OUTTEXTXY (44, 265, 'R--reveal a');
     OUTTEXTXY (44, 275, 'cell');
     OUTTEXTXY (44, 290, 'U--unmark a');
     OUTTEXTXY (44, 300, 'cell');
     OUTTEXTXY (44, 350, 'Press ESC');
     OUTTEXTXY (44, 360, 'to quit');

     SETCOLOR (LIGHTGREEN);
     OUTTEXTXY (44, 215, 'C');
     OUTTEXTXY (44, 240, 'Q');
     OUTTEXTXY (44, 265, 'R');
     OUTTEXTXY (44, 290, 'U');

     SETVIEWPORT (230, 140, 540, 420, TRUE);
     Len := 280 DIV Size;

     {Highlight the first cell}
     SETCOLOR (LIGHTRED);
     SETLINESTYLE (SOLIDLN, 0, NORMWIDTH);
     RECTANGLE (0, 0, Len - 1, Len - 1);

     SETTEXTSTYLE (SMALLFONT, HORIZDIR, 8);
     SETTEXTJUSTIFY (CENTERTEXT, CENTERTEXT);
     x := 1;
     y := 1;
     ch := ' ';

     Right := 0;
     Wrong := 0;
     Dead := FALSE;

     WHILE (Cells > Mines) AND (Dead = FALSE) AND (ch <> CHR (27))  AND (Right < Mines) DO
        BEGIN
           ch := UPCASE (READKEY);

           {Unhightlight the old cell}
           x_Loc := (x - 1) * Len;
           y_Loc := (y - 1) * Len;

           IF Mine_Field.Status [x, y] <> REVEALED
              THEN
                 BEGIN
                    SETCOLOR (WHITE);
                    SETLINESTYLE (SOLIDLN, 0, NORMWIDTH);
                    LINE (x_Loc, y_Loc, x_Loc + Len - 1, y_Loc);
                    LINE (x_Loc, y_Loc, x_Loc, y_Loc + Len - 1);
                    SETCOLOR (DARKGRAY);
                    LINE (x_Loc + Len - 1, y_Loc, x_Loc + Len - 1, y_Loc + Len - 1);
                    LINE (x_Loc, y_Loc + Len - 1, x_Loc + Len - 1, y_Loc + Len - 1);
                 END

              ELSE
                 BEGIN
                    SETCOLOR (WHITE);
                    SETLINESTYLE (SOLIDLN, 0, THICKWIDTH);
                    RECTANGLE (x_Loc, y_Loc, x_Loc + Len - 1, y_Loc + Len - 1);
                 END;

           CASE ch OF
              CHR (72) : IF y = 1                {Up arrow key}
                              THEN y := Size
                              ELSE y := y - 1;

              CHR (80) : IF y = Size             {Down arrow key}
                              THEN y := 1
                              ELSE y := y + 1;

              CHR (75) : IF x = 1                {Left arrow key}
                              THEN x := Size
                              ELSE x := x - 1;

              CHR (77) : IF x = Size             {Right arrow key}
                              THEN x := 1
                              ELSE x := x + 1;

              'C' : WITH Mine_Field DO           {Mark a cell as a mine}
                       IF (Status [x, y] = COVERED) OR (Status [x, y] = QUES)
                          THEN
                             BEGIN
                                Status [x, y] := MARKED;
                                x_Loc := x_LoC + Len DIV 2;
                                y_Loc := y_Loc + Len DIV 2;

                                IF Status [x, y] = QUES
                                   THEN
                                      BEGIN
                                         SETCOLOR (LIGHTGRAY);
                                         OUTTEXTXY (x_Loc, y_Loc, '?');
                                      END;

                                SETCOLOR (BLACK);
                                OUTTEXTXY (x_Loc, y_Loc, 'M');

                                IF Field [x, y] = '+'
                                   THEN Right := Right + 1
                                   ELSE Wrong := Wrong + 1;
                             END; {if}

              'U' : {Unmark a cell that has been marked as mine}
                    WITH Mine_Field DO
                       IF Status [x, y] = MARKED
                          THEN
                             BEGIN
                                Status [x, y] := COVERED;
                                PUTIMAGE (x_Loc, y_Loc, p^, NORMALPUT);
                                Right := Right - 1;
                             END;

              'R' : {Reveal a cell}
                    WITH Mine_Field DO
                       IF (Field [x, y] <> '+') AND (Status [x, y] = COVERED)
                          THEN
                             BEGIN
                                Show_Cell (x, y, Len, Size, q, Cells, Mine_Field);
                                Status [x, y] := REVEALED;
                             END

                          ELSE IF Field [x, y] = '+'
                                    THEN Dead := TRUE;

              'Q' : {Put a question mark on a cell}
                    WITH Mine_Field DO
                       IF (Status [x, y] = COVERED) AND (Status [x, y] <> MARKED)
                          THEN BEGIN
                             x_Loc := x_Loc + Len DIV 2;
                             y_Loc := y_Loc + Len DIV 2;
                             SETCOLOR (YELLOW);
                             OUTTEXTXY (x_Loc, y_Loc, '?');
                             Status [x, y] := QUES;
                          END;

           END; {case}

           SETCOLOR (LIGHTRED);
           SETLINESTYLE (SOLIDLN, 0, NORMWIDTH);
           x_Loc := (x - 1) * Len;
           y_Loc := (y - 1) * Len;
           RECTANGLE (x_Loc, y_Loc, x_Loc + Len - 1, y_Loc + Len - 1);

        END; {while}

     FOR x := 1 TO Size DO
        FOR y := 1 TO Size DO
           WITH Mine_Field DO
              Uncover (x, y, Len, Size, Field [x, y], q, Status [x, y], Temp);

     SETVIEWPORT (0, 0, GETMAXX, GETMAXY, TRUE);
     Happy_Face (Dead);
     Player.Score := Scoring (Size, Cells, Right, Wrong);
     STR (Player.Score, Score_Num);
     SETCOLOR (LIGHTMAGENTA);
     SETTEXTSTYLE (SMALLFONT, HORIZDIR, 5);
     SETTEXTJUSTIFY (LEFTTEXT, TOPTEXT);
     OUTTEXTXY (92, 145, Score_Num);

     SETCOLOR (BLACK);
     SETTEXTJUSTIFY (LEFTTEXT, TOPTEXT);
     OUTTEXTXY (44, 350, 'Press ESC');
     OUTTEXTXY (44, 360, 'to quit');
     SETCOLOR (WHITE);
     OUTTEXTXY (44, 350, 'Press <ENTER>');
     OUTTEXTXY (44, 360, 'to continue...');

     ch := ' ';
     REPEAT
          ch := READKEY;
     UNTIL ch = CHR (13);
     Top_Scores (Player);

     View_Screen;

END; {end of procedure}

PROCEDURE Help;

VAR
     c : INTEGER;
     ch : CHAR;
     s : STRING;
     file1 : TEXT;

BEGIN

     {Display the help file}
     ASSIGN (file1, 'HELP.TXT');
     RESET (file1);
     READLN (file1);

     Star_Field (360, 280, 190, 140);
     SETTEXTSTYLE (SMALLFONT, HORIZDIR, 5);
     SETCOLOR (GREEN);
     FOR c := 1 TO 22 DO
          BEGIN
               READLN (file1, s);
               OUTTEXTXY (188, 120 + c * 12, s);
          END;

     SETCOLOR (RED);
     OUTTEXTXY (280, 402, 'Press <ENTER> to continue');
     ch := ' ';
     REPEAT
          ch := READKEY;
     UNTIL ch = CHR (13);

     SETFILLSTYLE (SOLIDFILL, BLACK);
     FLOODFILL (188, 132, LIGHTBLUE);
     Star_Field (360, 280, 190, 140);
     SETCOLOR (GREEN);
     FOR c := 1 TO 15 DO
          BEGIN
               READLN (file1, s);
               OUTTEXTXY (188, 120 + c * 12, s);
          END;

     SETCOLOR (RED);
     OUTTEXTXY (280, 402, 'Press <ENTER> to continue');
     ch := ' ';
     REPEAT
          ch := READKEY;
     UNTIL ch = CHR (13);
     FLOODFILL (188, 132, LIGHTBLUE);
     CLOSE (file1);

END; {end of procedure}

PROCEDURE Fame;

CONST
     Center_X = 377;

VAR
     x, y : INTEGER;                   {loop variable}
     Player : Player_Type;             {top five from WINNER.TXT}
     Name_S, Score_S : STRING;
     File1 : TEXT;                     {file handle for WINNER.TXT}
     ch : CHAR;

BEGIN

     {Display winners}
     ASSIGN (File1, 'WINNER.TXT');
     RESET (File1);
     READLN (File1);
     READLN (File1);

     SETFILLSTYLE (SOLIDFILL, BLACK);
     FLOODFILL (377, 280, LIGHTBLUE);

     SETCOLOR (WHITE);
     OUTTEXTXY (184, 444, 'Press any key to return to menu');

     WHILE (NOT EOF (File1)) AND (NOT KEYPRESSED) DO
          WITH Player DO
               BEGIN
                    READ (File1, Name);

                    {Remove extra spaces}
                    Name_S := '';
                    x := POS (' ', Name);
                    Name_S := COPY (Name, 1, x);
                    DELETE (Name, 1, x);
                    x := POS (' ', Name) - 1;
                    Name_S := Name_S + COPY (Name, 1, x);

                    READ (File1, Score);
                    READLN (File1);
                    STR (Score, Score_S);

                    SETTEXTJUSTIFY (CENTERTEXT, TOPTEXT);
                    y := 370;

                    Star_Field (360, 280, 190, 140);

                    {Move the text from the bottom of the screen up to the
                    middle of the screen}
                    WHILE y >= 215 DO
                         BEGIN

                              SETCOLOR (WHITE);
                              OUTTEXTXY (Center_X, y, Name_S);
                              OUTTEXTXY (Center_X, y + 52, Score_S);

                              DELAY (Wait1);

                              SETCOLOR (BLACK);
                              OUTTEXTXY (Center_X, y, Name_S);
                              OUTTEXTXY (Center_X, y + 52, Score_S);
                              y := y - 2;

                         END; {while}

                    SETCOLOR (WHITE);
                    OUTTEXTXY (Center_X, y, Name_S);
                    SETCOLOR (YELLOW);
                    OUTTEXTXY (Center_X, y + 52, Score_S);

                    {Underline the text}
                    Draw_Underline (Center_X);
                    DELAY (Wait);

                    SETFILLSTYLE (SOLIDFILL, BLACK);
                    FLOODFILL (Center_X, 235, BLACK);
                    FLOODFILL (Center_X, 285, BLACK);

                    {Move the text to the top of the screen}
                    WHILE y >= 135 DO
                         BEGIN
                              IF y > 160
                                   THEN SETCOLOR (LIGHTGRAY)
                                   ELSE SETCOLOR (DARKGRAY);

                              OUTTEXTXY (Center_X, y, Name_S);
                              OUTTEXTXY (Center_X, y + 52, Score_S);

                              DELAY (Wait1);

                              SETCOLOR (BLACK);
                              OUTTEXTXY (Center_X, y, Name_S);
                              OUTTEXTXY (Center_X, y + 52, Score_S);
                              y := y - 2;
                         END; {while}

                    DELAY (Wait2);

                    FLOODFILL (Center_X, 280, LIGHTBLUE);

               END; {with}

     CLOSE (File1);

     {Clear keyboard buffer}
     ch := READKEY;

     SETTEXTJUSTIFY (LEFTTEXT, TOPTEXT);
     SETCOLOR (LIGHTBLUE);
     OUTTEXTXY (184, 444, 'Press any key to return to menu');

END; {end of procedure}

PROCEDURE Option (VAR Mines, Size : INTEGER);

CONST
     Level : ARRAY [0..2, 0..2] OF STRING
                  = (('EASY', '8 X 8', '3'),
                     ('MEDIUM', '10 X 10', '20'),
                     ('HARD', '12 X 12', '30'));
VAR
     c, d, Err,
     Sel : INTEGER;
     Ch : CHAR;

BEGIN

     {Select the difficulty level}
     SETCOLOR (LIGHTGREEN);
     OUTTEXTXY (50, 50, 'Level: ');
     OUTTEXTXY (50, 60, 'Size: ');
     OUTTEXTXY (50, 70, 'Mine #: ');

     SETCOLOR (CYAN);
     FOR c := 0 TO 2 DO
          FOR d := 0 TO 2 DO
               OUTTEXTXY (120 + c * 100, 50 + d * 10, Level [c, d]);

     SETCOLOR (LIGHTCYAN);
     FOR c := 0 TO 2 DO
          OUTTEXTXY (120, 50 + c * 10, Level [0, c]);


     Sel := 0;
     ch := ' ';

     SETCOLOR (WHITE);
     OUTTEXTXY (50, 444, 'Use left and right arrow key to highlight');
     OUTTEXTXY (362, 444, 'the option and then press enter');

     {Wait for the user to press a key}
     WHILE ch <> CHR (13) DO
          BEGIN
               ch := READKEY;

               {Unhighlight the selected choice}
               IF (ch = CHR (75)) OR (ch = CHR (77))
                    THEN BEGIN
                       SETCOLOR (CYAN);
                       FOR c := 0 TO 2 DO
                          OUTTEXTXY (120 + Sel * 100, 50 + c * 10, Level [Sel, c]);
                    END;

               CASE ch OF
                    CHR (75) : BEGIN             {left arrow key}
                                    IF Sel = 0
                                         THEN Sel := 2
                                         ELSE Sel := Sel - 1;
                               END; {case of CHR (75) }

                    CHR (77) : BEGIN             {right arrow key}
                                    IF Sel = 2
                                         THEN Sel := 0
                                         ELSE Sel := Sel + 1;
                               END; {case of CHR (77) }
               END; {case}

               SETCOLOR (LIGHTCYAN);
               FOR c := 0 TO 2 DO
                    OUTTEXTXY (120 + Sel * 100, 50 + c * 10, Level [Sel, c]);

          END; {while ch <> CHR (13) }

     SETCOLOR (LIGHTBLUE);
     OUTTEXTXY (50, 444, 'Use left and right arrow key to highlight');
     OUTTEXTXY (362, 444, 'the option and then press enter');

     CASE Sel OF
          0 : BEGIN
                   Mines := 3;
                   Size := 8;
              END;

          1 : BEGIN
                   Mines := 20;
                   Size := 10;
              END;

          2 : BEGIN
                   Mines := 30;
                   Size := 12;
              END;

     END; {case}
     View_Screen;

END; {end of procedure}

PROCEDURE Copyright;

VAR
     c : INTEGER;                      {loop variable}
     s : STRING;                       {one line of text from COPYRIT3.TXT}
     File1 : TEXT;                     {file handle}

BEGIN

     SETFILLSTYLE (SOLIDFILL, BLACK);
     FLOODFILL (400, 250, LIGHTBLUE);

     ASSIGN (File1, 'COPYRIT3.TXT');
     RESET (File1);

     SETCOLOR (LIGHTCYAN);

     FOR c := 1 TO 16 DO
          BEGIN
               READLN (File1, s);
               OUTTEXTXY (188, 120 + c * 12, s);
          END; {for}

     DELAY (Wait2);

END; {end of procedure}

PROCEDURE Menu (VAR Sel : INTEGER);

VAR

     c : INTEGER;                      {loop variable}
     ch : CHAR;                        {hold the value of the key pressed}

BEGIN

     SETTEXTSTYLE (SMALLFONT, HORIZDIR, 5);
     SETCOLOR (WHITE);

     {Print out the menu choices}
     FOR c := 1 TO Menu_Size DO
          OUTTEXTXY (44, 115 + c * 15, Choice [c]);


     SETCOLOR (YELLOW);
     OUTTEXTXY (44, 130, Choice [1]);

     Sel := 1;
     ch := ' ';

     SETTEXTJUSTIFY (LEFTTEXT, TOPTEXT);
     SETCOLOR (WHITE);
     OUTTEXTXY (50, 444, 'Use up and down arrow key to highlight');
     OUTTEXTXY (350, 444, 'the option and then press enter');

     {Wait for the user to press a key}
     WHILE ch <> CHR (13) DO
          BEGIN
               ch := READKEY;

               {Unhighlight the selected choice}
               IF (ch = CHR (72)) OR (ch = CHR (80))
                    THEN BEGIN
                         SETCOLOR (WHITE);
                         OUTTEXTXY (44, 115 + Sel * 15, Choice [Sel]);
                         END;

               CASE ch OF
                    CHR (72) : BEGIN             {up arrow key}
                                    IF Sel = 1
                                         THEN Sel := Menu_Size
                                         ELSE Sel := Sel - 1;
                               END; {case of CHR (72) }

                    CHR (80) : BEGIN             {down arrow key}
                                    IF Sel = Menu_Size
                                         THEN Sel := 1
                                         ELSE Sel := Sel + 1;
                               END; {case of CHR (80) }
               END; {case}

               {Highlight the selected choice}
               SETCOLOR (YELLOW);
               OUTTEXTXY (44, 115 + Sel * 15, Choice [Sel]);

          END; {while ch <> CHR (13) }

     SETCOLOR (LIGHTBLUE);
     OUTTEXTXY (50, 444, 'Use up and down arrow key to highlight');
     OUTTEXTXY (350, 444, 'the option and then press enter');

END; {end of procedure}

{============================Main Program====================================}
VAR
     Sel,                              {Menu choice}
     Mines, Size,                      {Num mines and the size of the board}
     Games : INTEGER;                  {Number of games played}

BEGIN

     SetUp;
     Header;
     Write_Text;
     View_Screen;
     Mines := 3;
     Size := 8;
     Games := 0;

     REPEAT
          Menu (Sel);

          CASE Sel OF
               1 : Game (Mines, Size, Games);
               2 : Help;
               3 : Fame;
               4 : Option (Mines, Size);
               5 : Copyright;

          END; {case}

     UNTIL Sel = 6;

     RESTORECRTMODE;

END.